indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages ------------------------------------------------------------------------ tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts --------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: Ignoring 1 observations p2## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 275)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.87414 12.87859 12.88302 12.88742 12.89177 12.89607 12.90031 12.90448
## [9] 12.90858 12.91258 12.91649 12.92030 12.92399 12.92756 12.93099 12.93429
## [17] 12.93744 12.94043 12.94325 12.94590 12.94836 12.95063 12.95272 12.95465
## [25] 12.95643 12.95807 12.95957 12.96093 12.96217 12.96329 12.96429 12.96517
## [33] 12.96596 12.96664 12.96723 12.96773 12.96815 12.96849 12.96876 12.96896
## [41] 12.96911 12.96920 12.96924 12.96924 12.96920 12.96912 12.96903 12.96891
## [49] 12.96877 12.96863 12.96840 12.96800 12.96744 12.96673 12.96587 12.96489
## [57] 12.96378 12.96255 12.96121 12.95977 12.95825 12.95664 12.95495 12.95321
## [65] 12.95140 12.94955 12.94766 12.94574 12.94380 12.94184 12.93988 12.93793
## [73] 12.93598 12.93406 12.93217 12.93031 12.92850 12.92675 12.92444 12.92102
## [81] 12.91660 12.91129 12.90520 12.89845 12.89114 12.88339 12.87530 12.86699
## [89] 12.85856 12.85014 12.84182 12.83372 12.82595 12.81863 12.81185 12.80574
## [97] 12.80040 12.79594 12.79248 12.78907 12.78476 12.77964 12.77379 12.76729
## [105] 12.76022 12.75267 12.74473 12.73647 12.72799 12.71936 12.71066 12.70199
## [113] 12.69343 12.68506 12.67695 12.66921 12.66191 12.65513 12.64897 12.64349
## [121] 12.63880 12.63496 12.63207 12.63020 12.62945 12.62989 12.63162 12.63470
## [129] 12.63979 12.64719 12.65654 12.66745 12.67953 12.69240 12.70569 12.71901
## [137] 12.73197 12.74420 12.75531 12.76492 12.77409 12.78405 12.79470 12.80593
## [145] 12.81762 12.82967 12.84197 12.85440 12.86687 12.87925 12.89144 12.90333
## [153] 12.91481 12.92577 12.93753 12.95115 12.96610 12.98186 12.99790 13.01371
## [161] 13.02875 13.04252 13.05448 13.06771 13.08525 13.10658 13.13116 13.15846
## [169] 13.18793 13.21904 13.25125 13.28403 13.31684 13.34915 13.38041 13.41009
## [177] 13.43766 13.46258 13.48431 13.50232 13.51607 13.52502 13.53103 13.53632
## [185] 13.54087 13.54467 13.54771 13.54997 13.55144 13.55210 13.55195 13.55096
## [193] 13.54913 13.54644 13.54288 13.53844 13.53309 13.52684 13.51966 13.51155
## [201] 13.50248 13.49245 13.48144 13.46944 13.45541 13.43858 13.41933 13.39804
## [209] 13.37510 13.35087 13.32575 13.30012 13.27435 13.24883 13.22394 13.20006
## [217] 13.17757 13.15401 13.12722 13.09802 13.06722 13.03565 13.00411 12.97343
## [225] 12.94442 12.91791 12.89214 12.86497 12.83659 12.80719 12.77697 12.74613
## [233] 12.71487 12.68337 12.65184 12.62047 12.58945 12.55899 12.52928 12.50051
## [241] 12.47191 12.44264 12.41281 12.38253 12.35191 12.32107 12.29012 12.25915
## [249] 12.22830 12.19765 12.16734 12.13746 12.10781 12.07811 12.04835 12.01855
## [257] 11.98870 11.95880 11.92886 11.89887 11.86884 11.83877 11.80866 11.77852
## [265] 11.74834 11.71812 11.68820 11.65880 11.62980 11.60109 11.57254 11.54402
## [273] 11.51542 11.48662 11.45748#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 275)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.53711 12.53697 12.53686 12.53678 12.53672 12.53670 12.53670 12.53673
## [9] 12.53678 12.53686 12.53697 12.53709 12.53724 12.53741 12.53760 12.53781
## [17] 12.53805 12.53829 12.53856 12.53884 12.53914 12.53946 12.53978 12.54008
## [25] 12.54038 12.54068 12.54096 12.54125 12.54153 12.54182 12.54210 12.54239
## [33] 12.54268 12.54298 12.54329 12.54360 12.54393 12.54426 12.54462 12.54498
## [41] 12.54537 12.54577 12.54619 12.54663 12.54710 12.54759 12.54811 12.54865
## [49] 12.54923 12.54983 12.55044 12.55102 12.55157 12.55211 12.55263 12.55313
## [57] 12.55362 12.55410 12.55457 12.55504 12.55551 12.55599 12.55647 12.55695
## [65] 12.55745 12.55796 12.55849 12.55904 12.55961 12.56020 12.56083 12.56148
## [73] 12.56217 12.56290 12.56367 12.56448 12.56533 12.56624 12.56720 12.56821
## [81] 12.56927 12.57040 12.57159 12.57285 12.57418 12.57558 12.57705 12.57860
## [89] 12.58023 12.58195 12.58375 12.58564 12.58762 12.58970 12.59187 12.59415
## [97] 12.59653 12.59901 12.60161 12.60340 12.60356 12.60222 12.59954 12.59563
## [105] 12.59065 12.58473 12.57800 12.57062 12.56270 12.55440 12.54585 12.53719
## [113] 12.52856 12.52010 12.51193 12.50421 12.49708 12.49065 12.48509 12.48052
## [121] 12.47709 12.47492 12.47417 12.47496 12.47744 12.48175 12.48845 12.49780
## [129] 12.50942 12.52294 12.53799 12.55420 12.57121 12.58863 12.60611 12.62327
## [137] 12.63974 12.65515 12.66913 12.68131 12.69381 12.70884 12.72616 12.74555
## [145] 12.76678 12.78962 12.81384 12.83920 12.86548 12.89246 12.91989 12.94755
## [153] 12.97521 13.00264 13.02961 13.05590 13.08126 13.10548 13.12831 13.14954
## [161] 13.16893 13.18626 13.20128 13.21625 13.23335 13.25225 13.27266 13.29424
## [169] 13.31669 13.33968 13.36291 13.38606 13.40881 13.43085 13.45186 13.47153
## [177] 13.48954 13.50557 13.51931 13.53045 13.53866 13.54364 13.54621 13.54741
## [185] 13.54730 13.54593 13.54333 13.53955 13.53463 13.52862 13.52157 13.51351
## [193] 13.50449 13.49456 13.48376 13.47214 13.45973 13.44659 13.43275 13.41827
## [201] 13.40318 13.38753 13.37137 13.35474 13.33655 13.31584 13.29283 13.26774
## [209] 13.24078 13.21218 13.18216 13.15093 13.11873 13.08576 13.05225 13.01841
## [217] 12.98447 12.95066 12.91717 12.88425 12.85210 12.82095 12.79102 12.76252
## [225] 12.73568 12.71072 12.68654 12.66193 12.63693 12.61157 12.58591 12.55997
## [233] 12.53380 12.50743 12.48092 12.45429 12.42760 12.40087 12.37414 12.34747
## [241] 12.32088 12.29442 12.26813 12.24205 12.21622 12.19067 12.16545 12.14060
## [249] 12.11616 12.09217 12.06866 12.04568 12.02311 12.00080 11.97873 11.95692
## [257] 11.93534 11.91400 11.89290 11.87203 11.85137 11.83094 11.81073 11.79072
## [265] 11.77092 11.75132 11.73192 11.71271 11.69369 11.67485 11.65619 11.63770
## [273] 11.61939 11.60124 11.58325#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 275)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.69899 11.71073 11.72239 11.73397 11.74545 11.75681 11.76804 11.77912
## [9] 11.79004 11.80078 11.81133 11.82167 11.83178 11.84166 11.85129 11.86065
## [17] 11.86973 11.87851 11.88698 11.89511 11.90291 11.91035 11.91741 11.92409
## [25] 11.93036 11.93622 11.94164 11.94662 11.95113 11.95518 11.95881 11.96202
## [33] 11.96485 11.96730 11.96940 11.97116 11.97260 11.97375 11.97462 11.97523
## [41] 11.97560 11.97574 11.97568 11.97543 11.97502 11.97446 11.97376 11.97296
## [49] 11.97207 11.97110 11.97007 11.96902 11.96794 11.96686 11.96581 11.96479
## [57] 11.96383 11.96231 11.95967 11.95598 11.95132 11.94577 11.93940 11.93229
## [65] 11.92453 11.91618 11.90732 11.89804 11.88841 11.87851 11.86841 11.85820
## [73] 11.84794 11.83773 11.82763 11.81773 11.80810 11.79882 11.78997 11.78162
## [81] 11.77386 11.76675 11.76038 11.75483 11.75018 11.74466 11.73667 11.72648
## [89] 11.71438 11.70064 11.68556 11.66940 11.65245 11.63500 11.61731 11.59968
## [97] 11.58238 11.56570 11.54992 11.53531 11.52217 11.51076 11.50138 11.49429
## [105] 11.48979 11.48816 11.48819 11.48852 11.48919 11.49023 11.49168 11.49356
## [113] 11.49590 11.49875 11.50213 11.50608 11.51063 11.51581 11.52166 11.52821
## [121] 11.53549 11.54353 11.55238 11.56205 11.57259 11.58402 11.59638 11.60971
## [129] 11.62646 11.64848 11.67484 11.70460 11.73685 11.77066 11.80510 11.83925
## [137] 11.87218 11.90297 11.93069 11.95441 11.97807 12.00577 12.03687 12.07070
## [145] 12.10662 12.14395 12.18206 12.22027 12.25794 12.29441 12.32902 12.36112
## [153] 12.39005 12.41515 12.43990 12.46760 12.49732 12.52813 12.55911 12.58935
## [161] 12.61791 12.64387 12.66630 12.68714 12.70882 12.73117 12.75400 12.77716
## [169] 12.80047 12.82376 12.84686 12.86959 12.89179 12.91328 12.93389 12.95344
## [177] 12.97178 12.98872 13.00410 13.01774 13.02946 13.03911 13.04740 13.05513
## [185] 13.06226 13.06876 13.07457 13.07967 13.08400 13.08753 13.09021 13.09201
## [193] 13.09288 13.09278 13.09168 13.08952 13.08627 13.08189 13.07633 13.06956
## [201] 13.06153 13.05220 13.04153 13.02949 13.01542 12.99890 12.98020 12.95961
## [209] 12.93741 12.91387 12.88928 12.86390 12.83803 12.81194 12.78590 12.76020
## [217] 12.73512 12.70661 12.67163 12.63194 12.58934 12.54559 12.50247 12.46176
## [225] 12.42524 12.39468 12.36671 12.33696 12.30573 12.27329 12.23996 12.20602
## [233] 12.17177 12.13749 12.10349 12.07006 12.03748 12.00606 11.97608 11.94784
## [241] 11.92033 11.89238 11.86412 11.83564 11.80704 11.77844 11.74992 11.72161
## [249] 11.69360 11.66600 11.63890 11.61243 11.58635 11.56042 11.53463 11.50899
## [257] 11.48351 11.45820 11.43306 11.40812 11.38336 11.35881 11.33447 11.31034
## [265] 11.28644 11.26278 11.23981 11.21788 11.19680 11.17641 11.15652 11.13697
## [273] 11.11758 11.09816 11.07856#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")